From 6b6b5c318e57986142a2cdbc63186f21b16a427a Mon Sep 17 00:00:00 2001
From: pc <pc@p-cos.net>
Date: Sun, 11 Sep 2005 12:47:06 +0000
Subject: [PATCH] Added checks for layer inheritance.

Inheritance between layers is not officially supported yet, but I have already added checks for ensuring active and inactive that would result in incorrect layer orderings.

darcs-hash:47fd8d829607c3210815da6d8b0057f58853f33e
---
 cx-layer.lisp | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

diff --git a/cx-layer.lisp b/cx-layer.lisp
index c968b10..5e83b0d 100644
--- a/cx-layer.lisp
+++ b/cx-layer.lisp
@@ -52,10 +52,13 @@
   (let ((layer-class (find-layer layer))
         (active-context-specializer (layer-context-specializer active-context)))
     (when (subtypep active-context-specializer layer-class)
-      (if (eq (first (class-direct-superclasses active-context-specializer)) layer-class)
-          (return-from maybe-create-active-layer-context active-context)
-        (setq active-context (ensure-inactive-layer-context layer active-context)
-              active-context-specializer (layer-context-specializer active-context))))
+      (let ((first-layer (first (class-direct-superclasses active-context-specializer))))
+        (cond ((eq first-layer layer-class)
+               (return-from maybe-create-active-layer-context active-context))
+              ((subtypep first-layer layer-class)
+               (error "Layer ~S cannot be placed in front of ~S because the latter inherits from the former." (layer-name layer-class) (layer-name first-layer)))
+              (t (setq active-context (ensure-inactive-layer-context layer active-context)
+                       active-context-specializer (layer-context-specializer active-context))))))
     (let ((new-specializer
            (make-instance 'standard-class
                           :direct-superclasses
@@ -94,7 +97,10 @@
             finally
             (return (loop with new-layer-context = *root-context*
                           for active-layer in (cdr active-layers)
-                          unless (eq active-layer layer-class) do
+                          if (subtypep active-layer layer-class) do
+                          (unless (eq active-layer layer-class)
+                            (error "The layer ~S cannot be deactivated or rearranged because the active layer ~S inherits from it." (layer-name layer-class) (layer-name active-layer)))
+                          else do
                           (setq new-layer-context
                                 (ensure-active-layer-context
                                  (class-name active-layer)
-- 
GitLab