Function: eieio--slot-override

eieio--slot-override is a byte-compiled function defined in eieio-core.el.gz.

Signature

(eieio--slot-override OLD NEW SKIPNIL)

Documentation

This function has :after advice: eieio--slot-override@closql-object.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/eieio-core.el.gz
(defun eieio--slot-override (old new skipnil)
  (cl-assert (eq (cl--slot-descriptor-name old) (cl--slot-descriptor-name new)))
  ;; There is a match, and we must override the old value.
  (let* ((a (cl--slot-descriptor-name old))
         (tp (cl--slot-descriptor-type old))
         (d (cl--slot-descriptor-initform new))
         (type (cl--slot-descriptor-type new))
         (oprops (cl--slot-descriptor-props old))
         (nprops (cl--slot-descriptor-props new))
         (custg (alist-get :group nprops)))
    ;; If type is passed in, is it the same?
    (if (not (eq type t))
        (if (not (equal type tp))
            (error
             "Child slot type `%s' does not match inherited type `%s' for `%s'"
             type tp a))
      (setf (cl--slot-descriptor-type new) tp))
    ;; If we have a repeat, only update the initarg...
    (unless (eq d eieio--unbound-form)
      (eieio--perform-slot-validation-for-default new skipnil)
      (setf (cl--slot-descriptor-initform old) d))

    ;; PLN Tue Jun 26 11:57:06 2007 : The protection is
    ;; checked and SHOULD match the superclass
    ;; protection. Otherwise an error is thrown. However
    ;; I wonder if a more flexible schedule might be
    ;; implemented.
    ;;
    ;; EML - We used to have (if prot... here,
    ;;       but a prot of 'nil means public.
    ;;
    (let ((super-prot (alist-get :protection oprops))
          (prot (alist-get :protection nprops)))
      (if (not (eq prot super-prot))
          (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'"
                 prot super-prot a)))
    ;; End original PLN

    ;; PLN Tue Jun 26 11:57:06 2007 :
    ;; Do a non redundant combination of ancient custom
    ;; groups and new ones.
    (when custg
      (let* ((list1 (alist-get :group oprops)))
        (dolist (elt custg)
          (unless (memq elt list1)
            (push elt list1)))
        (setf (alist-get :group (cl--slot-descriptor-props old)) list1)))
    ;;  End PLN

    ;;  PLN Mon Jun 25 22:44:34 2007 : If a new cust is
    ;;  set, simply replaces the old one.
    (dolist (prop '(:custom :label :documentation :printer))
      (when (alist-get prop (cl--slot-descriptor-props new))
        (setf (alist-get prop (cl--slot-descriptor-props old))
              (alist-get prop (cl--slot-descriptor-props new))))

      )  ))