[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ebdb 5e7a0d6 266/350: Change arg order of record-insert
|
From: |
Eric Abrahamsen |
|
Subject: |
[elpa] externals/ebdb 5e7a0d6 266/350: Change arg order of record-insert|delete-field, refactor |
|
Date: |
Mon, 14 Aug 2017 11:46:51 -0400 (EDT) |
branch: externals/ebdb
commit 5e7a0d6b9cc9c2e113a60b75ac5c0b4668682811
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>
Change arg order of record-insert|delete-field, refactor
* ebdb.el (ebdb-record-insert-field, ebdb-record-delete-field): The
slot argument now comes last, and is optional. Also, add
defgenerics.
* ebdb-snarf.el (ebdb-snarf-query): Remove field slot queries, and
handle new arg order (mostly dropping the slot argument).
* ebdb-mua.el (ebdb-mua-edit-field): Ditto.
* ebdb-com.el (ebdb-delete-records, ebdb-edit-field): Ditto.
* ebdb-test.el: New tests for adding/deleting/changing fields.
---
ebdb-com.el | 30 ++++--------
ebdb-mua.el | 16 +++----
ebdb-snarf.el | 19 +++-----
ebdb-test.el | 51 +++++++++++++++++++++
ebdb.el | 143 ++++++++++++++++++++++++++++++++--------------------------
5 files changed, 152 insertions(+), 107 deletions(-)
diff --git a/ebdb-com.el b/ebdb-com.el
index e01ab49..877695f 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -1156,8 +1156,8 @@ There are numerous hooks. M-x apropos ^ebdb.*hook RET
(lambda (pair)
(vector (ebdb-field-readable-name (cdr pair))
`(ebdb-record-insert-field
- ,record ',(car pair)
- (ebdb-read ,(cdr pair)))
+ ,record (ebdb-read ,(cdr pair))
+ ',(car pair))
t))
(ebdb-record-field-slot-query
(eieio-object-class record)))))
@@ -1415,9 +1415,9 @@ which is probably more suited for your needs."
(y-or-n-p (format "Delete %s: " form))))
(unless query (message "Deleting %s" form))
(dolist (m okay)
- (ebdb-record-insert-field record 'mail m))
+ (ebdb-record-insert-field record m 'mail))
(dolist (m redundant)
- (ebdb-record-delete-field record 'mail m)))))))
+ (ebdb-record-delete-field record m 'mail)))))))
(defun ebdb-touch-records (records)
"Touch RECORDS by calling `ebdb-change-hook' unconditionally."
@@ -1610,18 +1610,10 @@ is more than one), and prompt for the record class to
use."
(let
((field (ebdb-read class
(when (equal class 'ebdb-field-user-simple)
- `(:object-name ,label))))
- new-slot)
+ `(:object-name ,label)))))
(ebdb-with-record-edits (r records)
- ;; If we're adding the same field to many different records, of
- ;; different classes, it's possible that some of the records
- ;; won't accept this field, or will accept it in a different
- ;; slot.
(condition-case nil
- (progn
- (setq new-slot (car (ebdb-record-field-slot-query
- (eieio-object-class r) `(nil . ,class))))
- (ebdb-record-insert-field r new-slot field))
+ (ebdb-record-insert-field r field)
(ebdb-unacceptable-field
(message "Record %s cannot accept field %s" (ebdb-string r) field)
(sit-for 2)))))))
@@ -1697,7 +1689,7 @@ field to edit."
;; call it with these arguments. Shouldn't be doing low-level
;; work here.
(setq field (ebdb-read ebdb-default-notes-class))
- (ebdb-record-insert-field record 'notes field))))
+ (ebdb-record-insert-field record field 'notes))))
;; (ebdb-list-transpose '(a b c d) 1 3)
(defun ebdb-list-transpose (list i j)
@@ -1734,11 +1726,7 @@ confirm deletion."
(ebdb-field-readable-name field)
(car (split-string (ebdb-string field) "\n"))
(ebdb-record-name record))))
- (ebdb-record-delete-field
- record (car (ebdb-record-field-slot-query
- (eieio-object-class record)
- (cons nil (eieio-object-class field))))
- field))
+ (ebdb-record-delete-field record field))
(ebdb-redisplay-records record 'reformat t))))
;;;###autoload
@@ -2718,7 +2706,7 @@ is non-nil. Do not dial the extension."
(ebdb-read-string "URL label: "
nil ebdb-url-label-list))))
(let ((url-field (make-instance 'ebdb-field-url :url url :object-name
label)))
- (ebdb-record-insert-field record 'fields url-field)
+ (ebdb-record-insert-field record url-field 'fields)
(ebdb-display-records (list record))))
;;; Copy to kill ring
diff --git a/ebdb-mua.el b/ebdb-mua.el
index 3b01641..d9e190d 100644
--- a/ebdb-mua.el
+++ b/ebdb-mua.el
@@ -932,7 +932,7 @@ Return the records matching ADDRESS or nil."
(if (ebdb-eval-spec (ebdb-add-job ebdb-add-aka record
old-name)
(format "Keep name \"%s\" as an AKA? "
old-name))
(ebdb-record-insert-field
- record 'aka (slot-value record 'name))))
+ record (slot-value record 'name) 'aka)))
(ebdb-record-change-name record name)
(setq change-p 'name))
@@ -944,7 +944,7 @@ Return the records matching ADDRESS or nil."
(format "Make \"%s\" an alternate for
\"%s\"? "
name old-name)))
(ebdb-record-insert-field
- record 'aka (ebdb-parse 'ebdb-field-name name))
+ record (ebdb-parse 'ebdb-field-name name) 'aka)
(setq change-p 'name)))
;; Is MAIL redundant compared with the mail addresses
@@ -974,7 +974,7 @@ Return the records matching ADDRESS or nil."
(member-ignore-case (ebdb-string mail)
(ebdb-record-mail-canon record)))) ; do nothing
(created-p ; new record
- (ebdb-record-insert-field record 'mail (list mail)))
+ (ebdb-record-insert-field record (list mail) 'mail))
((not (setq add-mails (ebdb-add-job ebdb-add-mails record
mail)))) ; do nothing
@@ -1029,7 +1029,7 @@ Return the records matching ADDRESS or nil."
;; then modify RECORD
;; TODO: Reinstate the question about making this primary.
- (ebdb-record-insert-field record 'mail mail)
+ (ebdb-record-insert-field record mail 'mail)
(unless change-p (setq change-p t)))))
(cond (created-p
@@ -1214,7 +1214,7 @@ use all classes in `ebdb-message-headers'."
(let ((records (ebdb-update-records
(ebdb-get-address-components header-class)
'existing))
- field-instance slot)
+ field-instance)
(when records
(ebdb-display-records records nil nil nil (ebdb-popup-window))
(ebdb-with-record-edits (record records)
@@ -1223,10 +1223,8 @@ use all classes in `ebdb-message-headers'."
(setq field-instance (ebdb-record-field record field))
(if field-instance
(ebdb-record-change-field record field-instance)
- (setq field-instance (ebdb-read field)
- slot (car (ebdb-record-field-slot-query
- (eieio-object-class record) `(nil . ,field))))
- (ebdb-record-insert-field record slot field-instance))))))
+ (setq field-instance (ebdb-read field))
+ (ebdb-record-insert-field record field-instance))))))
;;;###autoload
(defun ebdb-mua-edit-field-sender (&optional field)
diff --git a/ebdb-snarf.el b/ebdb-snarf.el
index 6b238f1..a5888a2 100644
--- a/ebdb-snarf.el
+++ b/ebdb-snarf.el
@@ -336,14 +336,9 @@ automatically."
(ebdb-string elt)
(ebdb-string record)))
(condition-case nil
- (let ((slot (car (ebdb-record-field-slot-query
- (eieio-object-class record)
- `(nil . ,(eieio-object-class
elt))))))
- (ebdb-record-insert-field
- record
- slot
- elt)
- (ebdb-init-field elt record))
+ (ebdb-record-insert-field
+ record elt)
+ (ebdb-init-field elt record)
(ebdb-unacceptable-field nil))
(push elt leftovers)))
(dolist (n names)
@@ -351,7 +346,7 @@ automatically."
(ebdb-string n)
(ebdb-string record)))
(progn (ebdb-record-insert-field
- record 'aka n)
+ record n 'aka)
(ebdb-init-field n record))
(push n leftovers))))
;; We have no record, dump all the fields into LEFTOVERS.
@@ -376,10 +371,8 @@ automatically."
(ebdb-read ebdb-default-record-class))))
(t nil))))
(condition-case nil
- (let ((slot (car (ebdb-record-field-slot-query
- (eieio-object-class record)
- `(nil . ,(eieio-object-class f))))))
- (ebdb-record-insert-field record slot f)
+ (progn
+ (ebdb-record-insert-field record f)
(ebdb-init-field f record)
(add-to-list records record))
(ebdb-unacceptable-field nil))))
diff --git a/ebdb-test.el b/ebdb-test.el
index 718ece0..7bc43cc 100644
--- a/ebdb-test.el
+++ b/ebdb-test.el
@@ -99,6 +99,57 @@
(ebdb-db-add-record db rec)
(should (stringp (ebdb-record-uuid rec)))))))
+;; Test adding, deleting and changing fields.
+
+(ert-deftest ebdb-add-delete-record-field ()
+ "Add and delete fields."
+ (ebdb-test-with-records
+ (let ((rec (make-instance 'ebdb-record-person))
+ (mail (ebdb-parse ebdb-default-mail-class
+ "address@hidden"))
+ (phone (ebdb-parse ebdb-default-phone-class
+ "+1 (555) 555-5555")))
+ ;; Pass slot explicitly.
+ (ebdb-record-insert-field rec mail 'mail)
+ ;; Let the method find the slot.
+ (ebdb-record-insert-field rec phone)
+ (should (object-of-class-p
+ (car (ebdb-record-phone rec))
+ 'ebdb-field-phone))
+ (should (object-of-class-p
+ (car (ebdb-record-mail rec))
+ 'ebdb-field-mail))
+ (ebdb-record-delete-field rec mail)
+ (ebdb-record-delete-field rec phone 'phone)
+ (should (null (ebdb-record-mail rec)))
+ (should (null (ebdb-record-phone rec))))))
+
+(ert-deftest ebdb-insert-unacceptable ()
+ "Make sure records reject unacceptable fields."
+ (ebdb-test-with-records
+ (let ((rec (make-instance 'ebdb-record-person))
+ (field (make-instance 'ebdb-field-domain :domain "gnu.org")))
+ (should-error (ebdb-record-field-slot-query
+ 'ebdb-record-person (cons nil 'ebdb-field-domain))
+ :type 'ebdb-unacceptable-field)
+ (should-error (ebdb-record-insert-field rec field)
+ :type 'ebdb-unacceptable-field))))
+
+(ert-deftest ebdb-change-record-field ()
+ "Change record's field."
+ (ebdb-test-with-records
+ (let ((rec (make-instance 'ebdb-record-person))
+ (mail (ebdb-parse ebdb-default-mail-class
+ "address@hidden"))
+ (mail2 (ebdb-parse ebdb-default-mail-class
+ "address@hidden")))
+ (ebdb-record-insert-field rec mail)
+ (should (string= (ebdb-string (car (ebdb-record-mail rec)))
+ "address@hidden"))
+ (ebdb-record-change-field rec mail mail2)
+ (should (string= (ebdb-string (car (ebdb-record-mail rec)))
+ "address@hidden")))))
+
;; Field instance parse tests.
;; Test `ebdb-decompose-ebdb-address'
diff --git a/ebdb.el b/ebdb.el
index ef833e8..cd720e6 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -1974,22 +1974,42 @@ record."
(cl-defmethod ebdb-stamp-time ((record ebdb-record))
(ebdb-stamp-time (slot-value record 'timestamp)))
-(cl-defmethod ebdb-record-change-field ((record ebdb-record) (old-field
ebdb-field) &optional new-field)
- "Change the values of FIELD belonging to RECORD."
- (let* ((fieldclass (eieio-object-class old-field))
- (slot (car (ebdb-record-field-slot-query
- (eieio-object-class record)
- (cons nil fieldclass))))
- (new-field (or new-field (ebdb-read fieldclass nil old-field))))
- (when (or (null (equal old-field new-field))
- ebdb-update-unchanged-records)
- (ebdb-record-delete-field record slot old-field)
- (ebdb-record-insert-field record slot new-field)
- new-field)))
+(cl-defgeneric ebdb-record-field-slot-query (record-class &optional query
alist)
+ "Ask RECORD-CLASS for information about its interactively-settable fields.
+
+If QUERY is nil, simply return ALIST, which is a full list of
+acceptable fields. Each list element is a cons of the form (SLOT
+. FIELDCLASS), meaning that RECORD-CLASS can accept fields of
+class FIELDCLASS in SLOT.
+
+If QUERY is non-nil, it should be a cons of either '(SLOT . nil),
+or '(nil . FIELDCLASS). The \"nil\" is the value to query for:
+either \"which slot can accept this field class\", or \"which
+fieldclass is appropriate for this slot\". The return value in
+either case is a cons with both slot and fieldclass filled in.")
+
+(cl-defgeneric ebdb-record-insert-field (record field &optional slot)
+ "Insert FIELD into RECORD.
+
+If SLOT is given, insert FIELD into that slot. Otherwise, the
+slot will be found programmatically.")
+
+(cl-defgeneric ebdb-record-delete-field (record field &optional slot)
+ "Delete FIELD from RECORD.
+
+If SLOT is given, delete FIELD from that slot. Otherwise, the
+slot will be found programmatically.")
+
+(cl-defgeneric ebdb-record-change-field (record old-field &optional new-field)
+ "Change RECORD's field OLD-FIELD.
+
+If NEW-FIELD is given, OLD-FIELD will be replaced with NEW-FIELD.
+Otherwise, the user will be prompted to create a new field, using
+OLD-FIELD's values as defaults.")
(cl-defmethod ebdb-record-insert-field ((record ebdb-record)
- (slot symbol)
- (field ebdb-field))
+ (field ebdb-field)
+ &optional (slot symbol))
"Add FIELD to RECORD's SLOT."
;; First, the databases "actually" add the field to the record, ie
;; persistence. The rest of this method is just updating the
@@ -2005,18 +2025,19 @@ record."
(ebdb-init-field field record))
field)
-(cl-defmethod ebdb-record-insert-field ((record ebdb-record)
- slot
- (field ebdb-field))
+(cl-defmethod ebdb-record-insert-field :around ((record ebdb-record)
+ (field ebdb-field)
+ &optional slot)
(let ((real-slot
- (car (ebdb-record-field-slot-query
- (eieio-object-class record)
- `(nil . ,(eieio-object-class field))))))
- (cl-call-next-method record real-slot field)))
+ (or slot
+ (car (ebdb-record-field-slot-query
+ (eieio-object-class record)
+ `(nil . ,(eieio-object-class field)))))))
+ (cl-call-next-method record field real-slot)))
(cl-defmethod ebdb-record-delete-field ((record ebdb-record)
- (slot symbol)
- (field ebdb-field))
+ (field ebdb-field)
+ &optional (slot symbol))
"Delete FIELD from RECORD's SLOT, or set SLOT to nil, if no FIELD."
;; We don't use `slot-makeunbound' because that's a huge pain in the
;; ass, and why would anyone want those errors?
@@ -2027,28 +2048,27 @@ record."
(setf (slot-value record slot) nil))
(ebdb-delete-field field record))
-(cl-defmethod ebdb-record-delete-field ((record ebdb-record)
- slot
- (field ebdb-field))
+(cl-defmethod ebdb-record-delete-field :around ((record ebdb-record)
+ (field ebdb-field)
+ &optional slot)
(let ((real-slot
- (car (ebdb-record-field-slot-query
- (eieio-object-class record)
- `(nil . ,(eieio-object-class field))))))
- (cl-call-next-method record real-slot field)))
-
-(cl-defgeneric ebdb-record-field-slot-query (record-class &optional query
alist)
- "Ask RECORD-CLASS for information about its interactively-settable fields.
-
-If QUERY is nil, simply return ALIST, which is a full list of
-acceptable fields. Each list element is a cons of the form (SLOT
-. FIELDCLASS), meaning that RECORD-CLASS can accept fields of
-class FIELDCLASS in SLOT.
+ (or slot
+ (car (ebdb-record-field-slot-query
+ (eieio-object-class record)
+ `(nil . ,(eieio-object-class field)))))))
+ (cl-call-next-method record field real-slot)))
-If QUERY is non-nil, it should be a cons of either '(SLOT . nil),
-or '(nil . FIELDCLASS). The \"nil\" is the value to query for:
-either \"which slot can accept this field class\", or \"which
-fieldclass is appropriate for this slot\". The return value in
-either case is a cons with both slot and fieldclass filled in.")
+(cl-defmethod ebdb-record-change-field ((record ebdb-record)
+ (old-field ebdb-field)
+ &optional new-field)
+ "Change the values of FIELD belonging to RECORD."
+ (let* ((fieldclass (eieio-object-class old-field))
+ (new-field (or new-field (ebdb-read fieldclass nil old-field))))
+ (when (or (null (equal old-field new-field))
+ ebdb-update-unchanged-records)
+ (ebdb-record-delete-field record old-field)
+ (ebdb-record-insert-field record new-field)
+ new-field)))
(cl-defmethod ebdb-record-field-slot-query ((_class (subclass ebdb-record))
&optional query alist)
@@ -2296,17 +2316,17 @@ or actual image data."
(cl-defmethod ebdb-record-change-name ((record ebdb-record-entity)
(name ebdb-field-name))
(when (slot-value record 'name)
- (ebdb-record-delete-field record 'name (slot-value record 'name)))
+ (ebdb-record-delete-field record (slot-value record 'name) 'name))
(setf (slot-value (ebdb-record-cache record) 'name-string)
(ebdb-string name))
- (ebdb-record-insert-field record 'name name))
+ (ebdb-record-insert-field record name 'name))
(cl-defmethod ebdb-record-organizations ((_record ebdb-record-entity))
nil)
(cl-defmethod ebdb-record-insert-field :after ((record ebdb-record-entity)
- _slot
- (_mail ebdb-field-mail))
+ (_mail ebdb-field-mail)
+ &optional _slot)
"After giving RECORD a new mail field, sort RECORD's mails by
priority."
(let ((sorted (ebdb-sort-mails (slot-value record 'mail))))
@@ -2324,8 +2344,8 @@ priority."
;; This needs to be a :before method so that the 'address slot is
;; filled by the time we call `ebdb-init-field'.
(cl-defmethod ebdb-record-insert-field :before ((record ebdb-record-entity)
- _slot
- (field ebdb-field-mail-alias))
+ (field ebdb-field-mail-alias)
+ &optional _slot)
"After inserting a new alias field, prompt the user for which
address to use with it."
(unless (and (slot-boundp field 'address)
@@ -2580,7 +2600,7 @@ priority."
(ebdb-string org))))
(dolist (r org-entry)
(setq record (ebdb-gethash (slot-value r 'record-uuid) 'uuid))
- (ebdb-record-delete-field record 'organizations r)))
+ (ebdb-record-delete-field record r 'organizations)))
(cl-call-next-method)))
(cl-defmethod ebdb-string ((record ebdb-record-organization))
@@ -2662,17 +2682,12 @@ Currently only works for mail fields."
(ebdb-string m)
(ebdb-string org))))
(setf (slot-value r 'mail) m)
- (ebdb-record-delete-field
- record
- (car (ebdb-record-field-slot-query
- (eieio-object-class record)
- `(nil . ,(eieio-object-class m))))
- m)
+ (ebdb-record-delete-field record m)
(ebdb-init-field r record)))))))
(cl-defmethod ebdb-record-insert-field :after ((org ebdb-record-organization)
- _slot
- (_field ebdb-field-domain))
+ (_field ebdb-field-domain)
+ &optional _slot)
(let ((roles (gethash (ebdb-record-uuid org) ebdb-org-hashtable))
rec)
(dolist (r roles)
@@ -2691,14 +2706,14 @@ appropriate person record."
(cl-call-next-method record old-field new-field)))
(cl-defmethod ebdb-record-delete-field ((_record ebdb-record-organization)
- slot
- (field ebdb-field-role))
+ (field ebdb-field-role)
+ &optional slot)
(let ((record (ebdb-gethash (slot-value field 'record-uuid) 'uuid)))
- (cl-call-next-method record slot field)))
+ (cl-call-next-method record field slot)))
(cl-defmethod ebdb-record-insert-field :after ((record ebdb-record-person)
- _slot
- (field ebdb-field-role))
+ (field ebdb-field-role)
+ &optional _slot)
(let ((org (ebdb-gethash (slot-value field 'org-uuid) 'uuid)))
(when org
(ebdb-record-adopt-role-fields record org t))))
@@ -2727,7 +2742,7 @@ instances to add as part of the role."
(object-add-to-list role 'fields f)))
(when mail
(setf (slot-value role 'mail) mail))
- (ebdb-record-insert-field record 'organizations role)
+ (ebdb-record-insert-field record role 'organizations)
(ebdb-init-field role record)))
(defclass ebdb-record-mailing-list (ebdb-record eieio-named)
- [elpa] externals/ebdb e80753a 264/350: Change ebdb-record-change-name to accept strings, (continued)
- [elpa] externals/ebdb e80753a 264/350: Change ebdb-record-change-name to accept strings, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb d3e1485 283/350: Reinstate the notice record hook, and move notice-record method, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb d8bc159 290/350: Fairly embarrassing oversight in setting ebdb buffers modified, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb afe5495 279/350: Adjust indentation of multi-line field values, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb bbe407e 257/350: Code tweaks and re-arrangments, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 727eddb 262/350: Change databases' buffer-char slot into actual character, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 5362b12 291/350: require pyim, for chinese-pyim has been renamed to pyim (#45), Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb f62f15f 282/350: Pop up empty *EBDB* buffer for users with no records, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb f3f9f37 292/350: Move, rename and bind ebdb-mail-yank, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 89467fc 258/350: Don't wrap cl-print-object in eval-when-compile, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 5e7a0d6 266/350: Change arg order of record-insert|delete-field, refactor,
Eric Abrahamsen <=
- [elpa] externals/ebdb 75de073 314/350: Let ebdb-complete can grab string which similar "guix-devel" (#46), Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb dbf980e 288/350: Create specific keymap for using EBDB in MUAs, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 4a35635 297/350: Mention vCard export support in manual, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 13f32ef 304/350: Fix propertize call when formatting field values, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 9169c1e 309/350: When inserting fields, read the field but insert a clone, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 6c89a57 302/350: Mention record citing in the manual, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 110ece1 295/350: Mention internationalization library in the manual, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 3d4a236 299/350: Mention all supported MUAs in manual, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb aea28d9 313/350: Add test for with-record-edits macro, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 6687da1 244/350: Remove redundant customization group ebdb-utilities-snarf, Eric Abrahamsen, 2017/08/14