Add sorting rules for minor mode inheritance order

Add the options :mix-before and :mix-after to allow coordination between minor
modes regarding what order the minor modes are mixed in. Additionally adds class
sorting rules to the dynamic-mixins-swm package, contained in their own
file. This allows slightly finer grained control over what order methods are
called in by controlling the order of the mix list.

dynamic-mixins/dynamic-mixins-swm.asd

@@ -15,4 +15,5 @@
 
   :components
   ((:file "package")
+   (:file "sorting")
    (:file "dynamic-mixins")))

dynamic-mixins/src/dynamic-mixins.lisp

@@ -33,12 +33,16 @@ instance; further elements must be class names or classes."
                    (slot-value (class-of object-or-class) 'classes))
                   (t (list (class-of object-or-class))))))
     (make-mix-list
-     :list (remove-duplicates
-            (append (mapcar #'%find-class class-list)
-                    class0)))))
+     :list (sort (remove-duplicates
+                  (append (mapcar #'%find-class class-list)
+                          class0))
+                 'symbol-before-p
+                 :key 'class-name))))
 
 (defun mix (&rest classes)
-  (make-mix-list :list (remove-duplicates (mapcar #'%find-class classes))))
+  (make-mix-list :list (sort (remove-duplicates (mapcar #'%find-class classes))
+                             'symbol-before-p
+                             :key 'class-name)))
 
 (defun set-superclasses (class list)
   (reinitialize-instance class :direct-superclasses list))

dynamic-mixins/src/package.lisp

@@ -2,4 +2,5 @@
   (:use #:cl #:alexandria)
   (:export #:mixin-class #:mixin-object #:mixin-classes
            #:ensure-mix #:delete-from-mix #:mix
-           #:replace-class #:replace-class-in-mixin))
+           #:replace-class #:replace-class-in-mixin
+           #:set-rule #:*class-ordering-rules*))

dynamic-mixins/src/sorting.lisp

@@ -0,0 +1,43 @@
+(in-package :dynamic-mixins-swm)
+
+(defvar *class-ordering-rules* nil
+  "A plist of rules for how to order classes for mixing. Keys are the class
+names. Rules have the following shape:
+
+(:before ((string-1 . package-designator-1)
+          (string-2 . package-designator-2)
+          ...
+          (string-n . package-designator-n))
+ :after ((string-1 . package-designator-1)
+         (string-2 . package-designator-2)
+         ...
+         (string-n . package-designator-n)))")
+
+(defun set-rule (symbol before after)
+  "Add or replace a class ordering rule for SYMBOL."
+  (setf (getf *class-ordering-rules* symbol) (list :before before :after after)))
+
+(defun symbol-ordering-rules (symbol)
+  (getf *class-ordering-rules* symbol))
+
+(defun symbol-ordering-rules-before-list (symbol &optional rules)
+  (getf (or rules (symbol-ordering-rules symbol)) :before))
+
+(defun symbol-ordering-rules-after-list (symbol &optional rules)
+  (getf (or rules (symbol-ordering-rules symbol)) :after))
+
+(defun symbol-spec-match (symbol spec)
+  (let ((p (find-package (cdr spec))))
+    (when p
+      (eq (find-symbol (string (car spec)) p)
+          symbol))))
+
+(defun symbol-before-p (s1 s2)
+  "Return truthy if S1 should be before S2."
+  (or (find s2 (symbol-ordering-rules-before-list s1) :test #'symbol-spec-match)
+      (find s1 (symbol-ordering-rules-after-list s2) :test #'symbol-spec-match)))
+
+(defun symbol-after-p (s1 s2)
+  "Return truthy if S1 should be after S2."
+  (or (find s2 (symbol-ordering-rules-after-list s1) :test #'symbol-spec-match)
+      (find s1 (symbol-ordering-rules-before-list s2) :test #'symbol-spec-match)))

minor-modes.lisp

@@ -601,7 +601,9 @@ ROOT-MAP-SPEC."
               (:enable-when            . t)
               (:make-hooks             . 1)
               (:default-initargs       . t)
-              (:define-command-definer . 1)))
+              (:define-command-definer . 1)
+              (:mix-before             . t)
+              (:mix-after              . t)))
           (all-vals '())
           (other-opts '()))
       (flet ((collect-values (option)
@@ -1017,6 +1019,24 @@ are active only when the minor mode is active. Commands defined with this macro
 have the special variable *MINOR-MODE* bound to the minor mode object in their
 body. The generated macro is called DEFINE-MODE-COMMAND. This option defaults to
 T.
+
+@item
+(:MIX-BEFORE &REST RULES)@*
+The :MIX-BEFORE option defines rules on the order this class should be mixed in
+relative to other minor modes. This allows the implementer of a minor mode to
+make the mixing process aware of dependencies that dont otherwise make sense as
+a class hierarchy; If minor modes FOO and BAR both define around methods for the
+same method, but FOO's method must be called first, FOO can add a rule stating
+that it must come before BAR in the mixin list. RULES must be a set of conses
+which have the form (SYMBOL-DESIGNATOR . PACKAGE-DESIGNATOR). SYMBOL-DESIGNATOR
+must be a valid argument to #'STRING, and PACKAGE-DESIGNATOR must be a valid
+argument to #'FIND-PACKAGE. Together these shall form a single symbol which
+should be the class name of the minor mode being referred to by the rule.
+
+@item
+(:MIX-AFTER &REST RULES)@*
+The :MIX-AFTER option is similar to the :MIX-BEFORE option, except it specifies
+classes that this minor mode should occur after in the mixin list.
 @end itemize
 
 Example:
@@ -1043,7 +1063,7 @@ Example:
     (destructuring-bind (&key top-map root-map (expose-keymaps t) rebind
                            lighter lighter-make-clickable lighter-on-click
                            (scope :unscoped) interactive global
-                           (enable-when nil ewpp) 
+                           (enable-when nil ewpp) mix-before mix-after
                            (make-hooks t) (define-command-definer t)
                            default-initargs)
         mm-opts
@@ -1087,6 +1107,18 @@ Example:
               ,@slots)
              (:default-initargs ,@default-initargs)
              ,@other-opts)
+
+           ,@(when (or mix-after mix-before)
+               (flet ((mkc (s)
+                        (list 'cons (car s) (cdr s))))
+                 (let ((mix-a (mapcar #'mkc mix-after))
+                       (mix-b (mapcar #'mkc mix-before)))
+                   ;; Convert to explicit #'CONS calls to allow destructive
+                   ;; modification of data at runtime.
+                   `((dynamic-mixins-swm::set-rule ',mode
+                                                   (list ,@mix-b)
+                                                   (list ,@mix-a))))))
+           
            ,(if global 
                 `(defmethod minor-mode-global-p ((mode (eql ',mode))) t)
                 `(let ((method (ignore-errors