[Emacs-diffs] scratch/record dbb4691 13/13: Enable legacy defstruct compatibility.

[Lars Brinkhoff]

branch: scratch/record
commit dbb469132f3ac698f163e3cf337c039dd79acef5
Author: Lars Brinkhoff <address@hidden>
Commit: Lars Brinkhoff <address@hidden>

    Enable legacy defstruct compatibility.
    
    * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Pass `blue-sky' to
    cl-struct-define to signal use of record objects.
    
    * lisp/emacs-lisp/cl-preloaded.el (cl--struct-get-class): Likewise.
    (cl-struct-define): Enable legacy defstruct compatibility.
---
 lisp/emacs-lisp/cl-macs.el      | 4 ++--
 lisp/emacs-lisp/cl-preloaded.el | 9 +++++++++
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index c282938..a5a0769 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2847,8 +2847,8 @@ non-nil value, that slot cannot be set via `setf'.
        ;; struct as a parent.
        (eval-and-compile
          (cl-struct-define ',name ,docstring ',include-name
-                           ',type ,(eq named t) ',descs ',tag-symbol ',tag
-                           ',print-auto))
+                           ',(or type 'blue-sky) ,(eq named t) ',descs
+                           ',tag-symbol ',tag ',print-auto))
        ',name)))
 
 ;;; Add cl-struct support to pcase
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 7432dd4..a2ce1c3 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -79,6 +79,8 @@
         (let ((tag (intern (format "cl-struct-%s" name)))
               (type-and-named (get name 'cl-struct-type))
               (descs (get name 'cl-struct-slots)))
+          (if (null (car type-and-named))
+              (setq type-and-named (cons 'blue-sky (cdr type-and-named))))
           (cl-struct-define name nil (get name 'cl-struct-include)
                             (unless (and (eq (car type-and-named) 'vector)
                                          (null (cadr type-and-named))
@@ -110,6 +112,13 @@
 ;;;###autoload
 (defun cl-struct-define (name docstring parent type named slots children-sym
                               tag print)
+  (if (null type)
+      ;; Legacy defstruct, using tagged vectors.  Enable backward
+      ;; compatibility.
+      (setq old-struct-compat t))
+  (if (eq type 'blue-sky)
+      ;; Defstruct using record objects.
+      (setq type nil))
   (cl-assert (or type (not named)))
   (if (boundp children-sym)
       (add-to-list children-sym tag)