branch: externals/ebdb
commit 9bd965b62deb4ba75bdaf49e05fedbdcdffb5472
Author: Eric Abrahamsen <e...@ericabrahamsen.net>
Commit: Eric Abrahamsen <e...@ericabrahamsen.net>
Simplify ebdb-with-record-edits
* ebdb-com.el (ebdb-with-record-edits): This macro was trying too
hard. Instead of accepting a list of records, just operate on one
record at a time. There's some inefficiency -- with multiple
records belonging to the same database, there will be a duplicate
database check for each record -- but it's not an issue, and this
will give us a bit more freedom.
(ebdb-insert-field, ebdb-edit-field, ebdb-edit-foo,
ebdb-delete-field-or-record, ebdb-delete-records, ebdb-move-records,
ebdb-copy-records): Adjust macro calls in these locations.
* ebdb-test.el (ebdb-test-with-record-edits): Tweak test to match new
definition.
---
ebdb-com.el | 183 +++++++++++++++++++++++++----------------------------------
ebdb-test.el | 10 ++--
2 files changed, 82 insertions(+), 111 deletions(-)
diff --git a/ebdb-com.el b/ebdb-com.el
index b2301e9..452ff0f 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -1531,74 +1531,38 @@ Records are displayed using formatter FMT."
(ebdb-compare-records (ebdb-record-field record 'timestamp)
'creation-date 'equal) fmt))
-(defmacro ebdb-with-record-edits (spec &rest body)
- "Run BODY on all records listed in the cdr of SPEC.
-
-This macro checks that each record is editable; ie, that it
+(defmacro ebdb-with-record-edits (record &rest body)
+ "Run BODY, containing operations on RECORD.
+This macro checks that the record is editable; ie, that it
doesn't belong to a read-only database. It also throws an error
-and bails out if any of the database are unsynced.
-
-Then bind each editable record to the car of SPEC in turn, run
-`ebdb-change-hook' on the record, excecute BODY, run
-`ebdb-after-change-hook', and redisplay the record.
-
-SPEC should look like the first argument to `dolist'. This macro
-should be called as:
+and bails out if any of its databases are unsynced.
-\(ebdb-with-record-edits (r record-list)
- ...\)
-
-Note that RECORD-LIST will be replaced with the list of
-actually-editable records."
+Then it runs `ebdb-change-hook' on the record, executes BODY,
+runs `ebdb-after-change-hook', and redisplays the record."
(declare (indent 1) (debug ((symbolp form) body)))
- (let ((editable-records (cl-gensym))
- (bad-dbs (cl-gensym))
- (good-dbs (cl-gensym)))
- `(let (,editable-records ,bad-dbs ,good-dbs)
- (dolist (r ,(nth 1 spec))
- (unless
- ;; "Unless the record has a bum database..."
- (catch 'bad
- ;; Return nil unless we throw a 'bad.
- (condition-case err
- (dolist (d (slot-value (ebdb-record-cache r) 'database) nil)
- (cond ((object-assoc (slot-value d 'file) 'file ,good-dbs))
- ((object-assoc (slot-value d 'file) 'file ,bad-dbs)
- (throw 'bad t))
- (t
- (ebdb-db-editable d)
- (push d ,good-dbs))))
- (ebdb-unsynced-db
- (let ((db (cadr err)))
- (if (ebdb-db-dirty db)
- (error "Database %s is out of sync and has unsaved
changes" db)
- (if (or ebdb-auto-revert
- (yes-or-no-p
- (format "Database %s is out of sync, reload?"
- (ebdb-string db))))
- (progn
- (ebdb-reload-database db)
- (push db ,good-dbs))
- (push db ,bad-dbs)
- (message "Database %s is out of sync" db)
- (sit-for 1)
- (throw 'bad t)))))
- (ebdb-readonly-db
- (push (cadr err) ,bad-dbs)
- (message "Database %s is read-only" (cadr err))
- (sit-for 1)
- (throw 'bad t))))
- ;; No bum database, it's okay.
- (push r ,editable-records)))
- (dolist (,(car spec) ,editable-records)
- (run-hook-with-args 'ebdb-change-hook ,(car spec))
+ ;; I'm expecting that none of the local variables in this macro
+ ;; (including the "err" arg to `condition-case'), will be exposed
+ ;; within "body". Hopefully that's not wrong.
+ `(condition-case err
+ (progn
+ (dolist (d (slot-value (ebdb-record-cache ,record) 'database) nil)
+ (ebdb-db-editable d))
+ (run-hook-with-args 'ebdb-change-hook ,record)
,@body
- (run-hook-with-args 'ebdb-after-change-hook ,(car spec)))
- (dolist (b (buffer-list))
- (with-current-buffer b
- (when (derived-mode-p 'ebdb-mode)
- (set-buffer-modified-p t))))
- (ebdb-redisplay-records ,editable-records 'reformat))))
+ (run-hook-with-args 'ebdb-after-change-hook ,record)
+ (dolist (b (buffer-list))
+ (with-current-buffer b
+ (when (derived-mode-p 'ebdb-mode)
+ (set-buffer-modified-p t))))
+ (ebdb-redisplay-records ,record 'reformat))
+ (ebdb-unsynced-db
+ (let ((db (cadr err)))
+ (ebdb-reload-database db)
+ (message "Database %s is out of sync" db)
+ (sit-for 1)))
+ (ebdb-readonly-db
+ (message "Database %s is read-only" (cadr err))
+ (sit-for 1))))
;;;###autoload
(defun ebdb-create-record (db &optional record-class)
@@ -1654,16 +1618,17 @@ for these values."
(when (equal class 'ebdb-field-user-simple)
`(:object-name ,label))))
clone)
- (ebdb-with-record-edits (r records)
- (setq clone (clone field))
- (condition-case err
- (ebdb-record-insert-field r clone)
- (ebdb-unacceptable-field
- (message "Record %s cannot accept field %s" (ebdb-string r)
(ebdb-string field))
- (sit-for 2))
- (error
- (message "Error inserting field: %s, %s" (car err) (cdr err))
- (sit-for 2)))))))
+ (dolist (r records)
+ (ebdb-with-record-edits r
+ (setq clone (clone field))
+ (condition-case err
+ (ebdb-record-insert-field r clone)
+ (ebdb-unacceptable-field
+ (message "Record %s cannot accept field %s" (ebdb-string r)
(ebdb-string field))
+ (sit-for 2))
+ (error
+ (message "Error inserting field: %s, %s" (car err) (cdr err))
+ (sit-for 2))))))))
;; TODO: Allow editing of multiple record fields simultaneously.
;;;###autoload
@@ -1675,13 +1640,15 @@ the record."
(list (ebdb-current-record)
(ebdb-current-field)))
(let ((header-p (get-text-property (point) 'ebdb-record)))
- (ebdb-with-record-edits (r (list record))
+ (ebdb-with-record-edits record
(if header-p
- (let* ((old-name (slot-value r 'name))
- (new-name (ebdb-read (eieio-object-class old-name) nil
old-name)))
- (ebdb-record-change-name r new-name))
+ (let* ((old-name (slot-value record 'name))
+ (new-name (ebdb-read
+ (eieio-object-class old-name)
+ nil old-name)))
+ (ebdb-record-change-name record new-name))
(if (eieio-object-p field)
- (ebdb-record-change-field r field)
+ (ebdb-record-change-field record field)
(message "Point not in field"))))))
;;;###autoload
@@ -1690,11 +1657,11 @@ the record."
(interactive
(list (ebdb-current-record)
(ebdb-current-field)))
- (ebdb-with-record-edits (r (list record))
- (ebdb-record-delete-field r field)
+ (ebdb-with-record-edits record
+ (ebdb-record-delete-field record field)
(condition-case nil
(eieio-customize-object field)
- (error (ebdb-record-insert-field r field))))
+ (error (ebdb-record-insert-field record field))))
(setq ebdb-custom-field-record record))
(cl-defmethod eieio-done-customizing ((f ebdb-field))
@@ -1706,7 +1673,6 @@ the record."
;;;###autoload
(defun ebdb-edit-foo (record field)
"For RECORD edit some FIELD (mostly interactively).
-
Interactively, if called without a prefix, edit the notes field
of RECORD. When called with a prefix, prompt the user for a
field to edit."
@@ -1735,7 +1701,7 @@ field to edit."
field-list)))
(setq field (ebdb-record-field record 'notes)))
(list record field)))
- (ebdb-with-record-edits (r (list record))
+ (ebdb-with-record-edits record
(if field
(ebdb-record-change-field record field)
;; This is wrong, we need to rework `ebdb-insert-field' so we can
@@ -1764,35 +1730,38 @@ I and J start with zero. Return the modified LIST."
;;;###autoload
(defun ebdb-delete-field-or-record (records field &optional noprompt)
"For RECORDS delete FIELD.
-
-If point is on the record header (within the name), delete
-RECORDS from the database. If prefix NOPROMPT is non-nil, do not
-confirm deletion."
+If point is on the record header (within the name), offer to
+delete all RECORDS from the database. If prefix NOPROMPT is
+non-nil, do not confirm deletion. If point is on a field, offer
+to delete that field. Field deletion only operates on the record
+under point."
(interactive
(list (ebdb-do-records) (ebdb-current-field) current-prefix-arg))
(setq records (ebdb-record-list records))
(if (get-text-property (point) 'ebdb-record)
(ebdb-delete-records records noprompt)
- (ebdb-with-record-edits (record records)
- (when (or noprompt
- (y-or-n-p (format "Delete \"%s\" %s (of %s)? "
- (ebdb-field-readable-name field)
- (car (split-string (ebdb-string field) "\n"))
- (ebdb-record-name record))))
- (ebdb-record-delete-field record field))
- (ebdb-redisplay-records record 'reformat t))))
+ (let ((record (ebdb-current-record)))
+ (ebdb-with-record-edits record
+ (when (or noprompt
+ (y-or-n-p (format "Delete \"%s\" %s (of %s)? "
+ (ebdb-field-readable-name field)
+ (car (split-string (ebdb-string field) "\n"))
+ (ebdb-string record))))
+ (ebdb-record-delete-field record field))
+ (ebdb-redisplay-records record 'reformat t)))))
;;;###autoload
(defun ebdb-delete-records (records &optional noprompt)
"Delete RECORDS.
If prefix NOPROMPT is non-nil, do not confirm deletion."
(interactive (list (ebdb-do-records) current-prefix-arg))
- (ebdb-with-record-edits (r (ebdb-record-list records))
- (when (or noprompt
- (y-or-n-p (format "Delete the EBDB record of %s? "
- (ebdb-string r))))
- (ebdb-delete-record r)
- (ebdb-redisplay-records r 'remove t))))
+ (dolist (r (ebdb-record-list records))
+ (ebdb-with-record-edits r
+ (when (or noprompt
+ (y-or-n-p (format "Delete the EBDB record of %s? "
+ (ebdb-string r))))
+ (ebdb-delete-record r)
+ (ebdb-redisplay-records r 'remove t)))))
;;;###autoload
(defun ebdb-move-records (records db)
@@ -1800,8 +1769,9 @@ If prefix NOPROMPT is non-nil, do not confirm deletion."
This removes the records from their current database."
(interactive (list (ebdb-do-records)
(ebdb-prompt-for-db)))
- (ebdb-with-record-edits (r records)
- (ebdb-move-record r db)))
+ (dolist (r records)
+ (ebdb-with-record-edits r
+ (ebdb-move-record r db))))
;;;###autoload
(defun ebdb-copy-records (records db)
@@ -1809,8 +1779,9 @@ This removes the records from their current database."
The records also remain in their present database(s)."
(interactive (list (ebdb-do-records)
(ebdb-prompt-for-db)))
- (ebdb-with-record-edits (r records)
- (ebdb-copy-record r db)))
+ (dolist (r records)
+ (ebdb-with-record-edits r
+ (ebdb-copy-record r db))))
;;;###autoload
(defun ebdb-display-all-records (&optional fmt)
diff --git a/ebdb-test.el b/ebdb-test.el
index b2285e2..a5c4c86 100644
--- a/ebdb-test.el
+++ b/ebdb-test.el
@@ -219,11 +219,11 @@ If it doesn't exist, raise `ebdb-related-unfound'."
(ebdb-db-add-record db2 rec1)
(ebdb-db-add-record db1 rec2)
(setf (slot-value db2 'read-only) t)
- (ebdb-with-record-edits (r (list rec1 rec2))
- (ebdb-record-insert-field
- r (ebdb-parse 'ebdb-field-mail "n...@such.com")))
- ;; rec1 should have been excluded from the list of editable
- ;; records, but no error should be raised.
+ (dolist (rec (list rec1 rec2))
+ (ebdb-with-record-edits rec
+ (ebdb-record-insert-field
+ rec (ebdb-parse 'ebdb-field-mail "n...@such.com"))))
+ ;; Field insertion should have silently failed for rec1.
(should-not
(slot-value rec1 'mail)))))))
