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

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

[elpa] externals/ebdb 47e6be2 5/6: Stop using eieio-named as a mixin to


From: Eric Abrahamsen
Subject: [elpa] externals/ebdb 47e6be2 5/6: Stop using eieio-named as a mixin to provide labelling
Date: Tue, 10 Jul 2018 16:20:18 -0400 (EDT)

branch: externals/ebdb
commit 47e6be2bd76358fd5f17d830ab7f5738679f2590
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Stop using eieio-named as a mixin to provide labelling
    
    Apparently this was a misuse of eieio-named and its 'object-name slot.
    
    * ebdb.el (ebdb-field-labeled): This class is now a simple mixin, and
      provides both the 'label (formerly 'object-name) and 'label-list
      slots.
      (initialize-instance): Upgrade field instances and databases to use
      the new slot name.
    * ebdb-format.el (ebdb-formatter): Formatters should also not inherit
      from eieio-named; their slot name is also renamed from 'object-name
      to 'label.
    * ebdb-com.el:
    * ebdb-migrate.el:
    * ebdb-test.el:
    * ebdb-vcard.el: Rename slots everywhere.
---
 ebdb-com.el     |  10 ++---
 ebdb-format.el  |  12 ++++--
 ebdb-migrate.el |  10 ++---
 ebdb-test.el    |   2 +-
 ebdb-vcard.el   |  10 ++---
 ebdb.el         | 111 ++++++++++++++++++++++++++++++++++----------------------
 6 files changed, 91 insertions(+), 64 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index 842cb77..8036e0f 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -471,7 +471,7 @@ and 'role, and the special shortcuts 'mail-primary,
 
 (defcustom ebdb-default-multiline-formatter
   (make-instance 'ebdb-formatter-ebdb-multiline
-                :object-name "multiline formatter"
+                :label "multiline formatter"
                 :include ebdb-default-multiline-include
                 :exclude ebdb-default-multiline-exclude
                 :combine ebdb-default-multiline-combine
@@ -487,7 +487,7 @@ and 'role, and the special shortcuts 'mail-primary,
 
 (defcustom ebdb-default-oneline-formatter
   (make-instance 'ebdb-formatter-ebdb-oneline
-                :object-name "oneline formatter"
+                :label "oneline formatter"
                 :include ebdb-default-oneline-include)
   "The default oneline formatter of *EBDB* buffers."
   :type 'ebdb-formatter-ebdb-oneline
@@ -497,7 +497,7 @@ and 'role, and the special shortcuts 'mail-primary,
   (make-instance 'ebdb-formatter-ebdb-multiline
                 :include nil :exclude nil
                 :combine nil :collapse nil
-                :object-name "full formatter")
+                :label "full formatter")
   "Formatter used for displaying all values of a record.
 This formatter should not be changed.")
 
@@ -1716,7 +1716,7 @@ instance should be identical."
          (ebdb-record-field-slot-query
           (eieio-object-class (car records))))))
        (slots (when (equal class 'ebdb-field-user-simple)
-               `(:object-name ,label)))
+               `(:label ,label)))
        (field (when (or (= 1 (length records))
                        (y-or-n-p
                         "Insert same field values in all records? "))
@@ -2922,7 +2922,7 @@ message."
                        url
                       (ebdb-read-string "URL label: "
                                         nil ebdb-url-label-list))))
-  (let ((url-field (make-instance 'ebdb-field-url :url url :object-name 
label)))
+  (let ((url-field (make-instance 'ebdb-field-url :url url :label label)))
     (ebdb-record-insert-field record url-field 'fields)
     (ebdb-display-records (list record))))
 
diff --git a/ebdb-format.el b/ebdb-format.el
index 115bb2d..d08fc6d 100644
--- a/ebdb-format.el
+++ b/ebdb-format.el
@@ -35,8 +35,12 @@
 (defvar ebdb-formatter-tracker nil
   "Variable for holding all instantiated formatters.")
 
-(defclass ebdb-formatter (eieio-named eieio-instance-tracker)
-  ((tracking-symbol :initform ebdb-formatter-tracker)
+(defclass ebdb-formatter (eieio-instance-tracker)
+  ((label
+    :initarg :label
+    :type string
+    :initform "")
+   (tracking-symbol :initform ebdb-formatter-tracker)
    (coding-system
     :type symbol
     :initarg :coding-system
@@ -100,7 +104,7 @@
   Subclass this to produce real formatters.")
 
 (cl-defmethod ebdb-string ((fmt ebdb-formatter))
-  (slot-value fmt 'object-name))
+  (slot-value fmt 'label))
 
 (cl-defgeneric ebdb-fmt-header (fmt records)
   "Insert a string at the beginning of the list of records.")
@@ -341,7 +345,7 @@ grouped by field class."
   (let ((collection
         (mapcar
          (lambda (formatter)
-           (cons (slot-value formatter 'object-name) formatter))
+           (cons (slot-value formatter 'label) formatter))
          ebdb-formatter-tracker)))
     (cdr (assoc (completing-read "Use formatter: " collection)
                collection))))
diff --git a/ebdb-migrate.el b/ebdb-migrate.el
index dc31d11..e3f5eeb 100644
--- a/ebdb-migrate.el
+++ b/ebdb-migrate.el
@@ -499,7 +499,7 @@ BBDB sets the default of that option."
                                 (ebdb-vphone-suffix p))
                  extension (ebdb-vphone-extension p)))
          (push (make-instance ebdb-default-phone-class
-                              :object-name label
+                              :label label
                               :area-code area
                               :number (replace-regexp-in-string "[- ]+"
                                                                 "" number)
@@ -515,7 +515,7 @@ BBDB sets the default of that option."
              (country (aref a 5))
              (case-fold-search t))
          (push (make-instance ebdb-default-address-class
-                              :object-name label
+                              :label label
                               :streets streets
                               :locality city
                               :region state
@@ -575,7 +575,7 @@ BBDB sets the default of that option."
                                        (string-to-number (nth 1 date-bits))
                                        (string-to-number (nth 2 date-bits))
                                        (string-to-number (car date-bits)))
-                                :object-name (cadr bits))
+                                :label (cadr bits))
                  fields)))
         ((eq lab 'notes)
          (setq notes (make-instance 'ebdb-field-notes
@@ -612,7 +612,7 @@ BBDB sets the default of that option."
                fields))
         (t
          (push (make-instance 'ebdb-field-user-simple
-                              :object-name (symbol-name (car x))
+                              :label (symbol-name (car x))
                               :value val)
                fields)))))
     (make-instance ebdb-default-record-class
@@ -721,7 +721,7 @@ no processing beyond calling `ebdb-parse' on the string 
values.")
                                         :date  
(calendar-gregorian-from-absolute
                                                 (org-time-string-to-absolute
                                                  value))
-                                        :object-name "birthday"))))))
+                                        :label "birthday"))))))
              (when f
                (ebdb-record-insert-field record f)))
          (ebdb-unparseable
diff --git a/ebdb-test.el b/ebdb-test.el
index 2e856ce..9789348 100644
--- a/ebdb-test.el
+++ b/ebdb-test.el
@@ -642,7 +642,7 @@ and typing."))
                              :mail (list (ebdb-field-mail
                                           :mail "address@hidden"))
                              :phone (list (ebdb-field-phone
-                                           :object-name "home"
+                                           :label "home"
                                            :country-code 1
                                            :area-code 555
                                            :number "5555555"))
diff --git a/ebdb-vcard.el b/ebdb-vcard.el
index 768b598..aaac522 100644
--- a/ebdb-vcard.el
+++ b/ebdb-vcard.el
@@ -57,7 +57,7 @@
 
 (defcustom ebdb-vcard-default-40-formatter
   (make-instance 'ebdb-formatter-vcard-40
-                :object-name "VCard 4.0 (default)"
+                :label "VCard 4.0 (default)"
                 :combine nil
                 :collapse nil
                 :include '(ebdb-field-uuid
@@ -79,7 +79,7 @@
 
 (defcustom ebdb-vcard-default-30-formatter
   (make-instance 'ebdb-formatter-vcard-30
-                :object-name "VCard 3.0 (default)"
+                :label "VCard 3.0 (default)"
                 :combine nil
                 :collapse nil
                 :include '(ebdb-field-uuid
@@ -204,7 +204,7 @@ All this does is split role instances into multiple fields."
                          (ebdb-record-name org))
                    out-list)
              (push (cons (format "TITLE;TYPE=\"%s\"" (ebdb-record-name org))
-                         (slot-value f 'object-name))
+                         (slot-value f 'label))
                    out-list)
              (when (or mail fields)
                (dolist (elt (cons mail fields))
@@ -343,7 +343,7 @@ method is just responsible for formatting the record name."
                                    _style
                                    _record)
   (let ((ret (cl-call-next-method))
-       (lab (slot-value field 'object-name)))
+       (lab (slot-value field 'label)))
     (if lab
        (concat ret
                ";TYPE=" (ebdb-vcard-escape lab))
@@ -381,7 +381,7 @@ method is just responsible for formatting the record name."
                                    (ann ebdb-field-anniversary)
                                    _style
                                    _record)
-  (let* ((label (slot-value ann 'object-name))
+  (let* ((label (slot-value ann 'label))
         (label-string
          (if (string= label "birthday")
              "BDAY"
diff --git a/ebdb.el b/ebdb.el
index eeacace..43dc47e 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -976,16 +976,11 @@ in."
 (cl-defmethod ebdb-string ((field ebdb-field-uuid))
   (slot-value field 'uuid))
 
-;;; The labeled abstract class.  Can be subclassed, or used as a mixin.
-
-;; Probably there's no need to subclass from `ebdb-field'.  Without
-;; this, it will be a pure mixin class.  Probably we can do away with
-;; this inheritance without hurting anything.
-(defclass ebdb-field-labeled (ebdb-field eieio-named)
-  ;; Override the object-name slot from `eieio-named' so we can add a
-  ;; custom declaration to it.
-  ((object-name
-    :initarg :object-name
+;;; The labeled abstract class.  Used as a mixin.
+
+(defclass ebdb-field-labeled ()
+  ((label
+    :initarg :label
     :custom (choice (const :tag "Empty" nil)
                    string)
     :initform nil
@@ -1017,7 +1012,7 @@ process."
   (let* ((field (cl-call-next-method class slots obj))
         (labels (symbol-value (oref-default class label-list)))
         (human-readable (ebdb-field-readable-name class))
-        (label (slot-value field 'object-name)))
+        (label (slot-value field 'label)))
     (setq label (ebdb-with-exit
                    (ebdb-read-string
                     (if (stringp human-readable)
@@ -1029,20 +1024,36 @@ process."
                (member label labels)
                (yes-or-no-p
                 (format "%s is not a known label, define it? " label))))
-      (setf (slot-value field 'object-name) label))
+      (setf (slot-value field 'label) label))
     field))
 
 (cl-defmethod ebdb-init-field ((field ebdb-field-labeled) _record)
   "Add FIELD's label to its class label list."
   (let ((label-var (slot-value field 'label-list)))
-    (ebdb-add-to-list (symbol-value label-var) (slot-value field 'object-name))
+    (ebdb-add-to-list (symbol-value label-var) (slot-value field 'label))
     (cl-call-next-method)))
 
 (cl-defmethod eieio-object-name-string ((field ebdb-field-labeled))
   "Return a string which is FIELD's name."
-  (or (slot-value field 'object-name)
+  (or (slot-value field 'label)
       (ebdb-field-readable-name (eieio-object-class field))))
 
+;; Backwards-compatibility upgrade.  `ebdb-field-labeled' used to
+;; subclass `eieio-named', but apparently that was a bit of a misuse,
+;; so we need to upgrade the :object-name slot name to :label instead.
+(cl-defmethod initialize-instance ((field ebdb-field-labeled)
+                                  &optional slots)
+  (let ((obj-name (plist-get slots :object-name))
+       p)
+    (when obj-name
+      (while slots
+       (when (not (eq :object-name (car slots)))
+         (setq p (plist-put p (car slots) (nth 1 slots))))
+       (setq slots (cddr slots)))
+      (when obj-name
+       (setq p (plist-put p :label obj-name))))
+    (cl-call-next-method field (or p slots))))
+
 ;; The obfuscated field type.  This is a little goofy, but might come
 ;; in handy.
 
@@ -1104,7 +1115,7 @@ process."
   (let ((val (slot-value field 'value)))
     (if (stringp val)
        val
-      (ebdb-concat (intern-soft (slot-value field 'object-name)) val))))
+      (ebdb-concat (intern-soft (slot-value field 'label)) val))))
 
 ;; TODO: Maybe replicate the ability to insert a lisp sexp directly,
 ;; in interactive mode?
@@ -1459,8 +1470,7 @@ first one."
     be used as the default.  Only one of a record's addresses can
     be set to 'primary.")
    (actions :initform '(("Compose mail" . ebdb-field-mail-compose))))
-  :documentation "A field representing a single email address.
-  The optional \"object-name\" slot can serve as a mail aka."
+  :documentation "A field representing a single email address."
   :human-readable "mail")
 
 (cl-defmethod ebdb-init-field ((field ebdb-field-mail) record)
@@ -1577,7 +1587,7 @@ Primary sorts before normal sorts before defunct."
   :human-readable "address")
 
 (cl-defmethod ebdb-init-field ((address ebdb-field-address) _record)
-  (with-slots (object-name streets locality region postcode country) address
+  (with-slots (streets locality region postcode country) address
     (dolist (s streets)
       (ebdb-add-to-list ebdb-street-list s))
     (ebdb-add-to-list ebdb-locality-list locality)
@@ -1619,7 +1629,7 @@ Primary sorts before normal sorts before defunct."
      class
      `(:streets ,streets
                :locality ,locality
-               :object-name ,(plist-get slots :object-name)
+               :label ,(plist-get slots :label)
                :region ,region
                :postcode ,postcode
                :country ,country)
@@ -2202,7 +2212,7 @@ See `ebdb-url-valid-schemes' for a list of acceptable 
schemes."
                                         (when obj (slot-value obj 
'bank-name)))))
        (bank-address (or (plist-get slots :bank-address)
                          (ebdb-with-exit
-                          (ebdb-read 'ebdb-field-address '(:object-name 
"office")
+                          (ebdb-read 'ebdb-field-address '(:label "office")
                                      (when obj (slot-value obj 
'bank-address))))))
        (routing-aba (or (plist-get slots :routing-aba)
                         (ebdb-with-exit
@@ -2913,7 +2923,7 @@ If FIELD doesn't specify a year, use the current year."
                  (if (nth 2 cal-date)
                      "%d%s "
                    "%s ")
-                 (slot-value field 'object-name))
+                 (slot-value field 'label))
          (apply #'format (if (nth 2 cal-date)
                              "(diary-anniversary %s %s %s)"
                            "(diary-anniversary %s %s)")
@@ -3496,9 +3506,13 @@ string."
 
 ;;; The database class(es)
 
-(defclass ebdb-db (eieio-named eieio-persistent)
+(defclass ebdb-db (eieio-persistent)
   ;; Is there a need for a "remote" slot?
-  ((uuid
+  ((label
+    :initarg :label
+    :initform ""
+    :type string)
+   (uuid
     :initarg :uuid
     :initform nil
     :type (or null ebdb-field-uuid)
@@ -3588,14 +3602,23 @@ not be instantiated directly, subclass it instead."
   :abstract t)
 
 (cl-defmethod initialize-instance ((db ebdb-db) &optional slots)
-  "Make sure DB has a uuid."
-  (unless (and (slot-boundp db 'uuid)
-              (slot-value db 'uuid))
-    (setf (slot-value db 'uuid)
-         (make-instance 'ebdb-field-uuid
-                        :uuid (ebdb-make-uuid
-                               (slot-value db 'uuid-prefix)))))
-  (cl-call-next-method db slots))
+  "Make sure DB has a uuid.
+Also switch old :object-name slot name to :label."
+  (let ((obj-name (plist-get slots :object-name))
+       p)
+    (unless (and (slot-boundp db 'uuid)
+                (slot-value db 'uuid))
+      (setf (slot-value db 'uuid)
+           (make-instance 'ebdb-field-uuid
+                          :uuid (ebdb-make-uuid
+                                 (slot-value db 'uuid-prefix))))))
+  (while slots
+    (when (not (eq :object-name (car slots)))
+      (setq p (plist-put p (car slots) (nth 1 slots))))
+    (setq slots (cddr slots)))
+  (when obj-name
+    (setq p (plist-put p :label obj-name)))
+  (cl-call-next-method db p))
 
 ;;; Home-made auto saving for `eieio-persistent' objects.  The
 ;;; `ebdb-db-save' :after method deletes the auto save file, and the
@@ -3960,8 +3983,8 @@ process.")
 ;; all the set up we need.
 
 (cl-defmethod initialize-instance ((db ebdb-db-file) &optional slots)
-  (let ((object-name (concat "File: " (plist-get slots :file))))
-    (setq slots (plist-put slots :object-name object-name))
+  (let ((label (concat "File: " (plist-get slots :file))))
+    (setq slots (plist-put slots :label label))
     (cl-call-next-method db slots)))
 
 (cl-defmethod ebdb-db-add-record ((db ebdb-db-file) record)
@@ -4164,10 +4187,10 @@ prompting if there's only one database."
                              nil
                              (mapcar
                               (lambda (d)
-                                (slot-value d 'object-name))
+                                (slot-value d 'label))
                               collection)
                              t))
-      (object-assoc db-string 'object-name collection))))
+      (object-assoc db-string 'label collection))))
 
 (defun ebdb-prompt-for-mail (record)
   "Prompt for one of RECORD's mail addresses.
@@ -4204,18 +4227,18 @@ If RECORDS are given, only search those records."
   (object-assoc (if (stringp label)
                    label
                  (symbol-name label))
-               'object-name (ebdb-record-user-fields record)))
+               'label (ebdb-record-user-fields record)))
 
 (defun ebdb-record-address (record &optional label)
   (let ((addresses (slot-value record 'address)))
     (if label
-       (object-assoc label 'object-name addresses)
+       (object-assoc label 'label addresses)
       addresses)))
 
 (defun ebdb-record-phone (record &optional label)
   (let ((phones (slot-value record 'phone)))
     (if label
-       (object-assoc label 'object-name phones)
+       (object-assoc label 'label phones)
       phones)))
 
 (defun ebdb-record-mail (record &optional roles label defunct)
@@ -4237,7 +4260,7 @@ addresses."
                          (null (eq (slot-value m 'priority) 'defunct)))
                        mails)))
     (if label
-       (object-assoc label 'object-name mails)
+       (object-assoc label 'label mails)
       mails)))
 
 
@@ -4304,10 +4327,10 @@ leading \"+\"."
   (let* ((all-phones (slot-value record 'phone))
         (phone
          (car-safe
-          (or (object-assoc "signal" 'object-name all-phones)
+          (or (object-assoc "signal" 'label all-phones)
               (seq-filter
                (lambda (p)
-                 (member (slot-value p 'object-name)
+                 (member (slot-value p 'label)
                          '("cell" "mobile")))
                all-phones))))
         (number
@@ -5287,15 +5310,15 @@ With optional argument INVERT, invert the search 
results."
        (value (cdr pair)))
     (and (or (null label)
             (string-empty-p label)
-            (string-match-p label (slot-value field 'object-name)))
+            (string-match-p label (slot-value field 'label)))
         (or (null value)
             (ebdb-field-search field value)))))
 
 (cl-defmethod ebdb-field-search ((field ebdb-field-labeled)
                                 (regexp string))
   (or (string-match-p regexp (ebdb-string field))
-      (and (stringp (slot-value field 'object-name))
-          (string-match-p regexp (slot-value field 'object-name)))
+      (and (stringp (slot-value field 'label))
+          (string-match-p regexp (slot-value field 'label)))
       (cl-call-next-method)))
 
 (cl-defmethod ebdb-field-search ((_field ebdb-field-name-complex) _regex)



reply via email to

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