Index: doc/define.n
==================================================================
--- doc/define.n
+++ doc/define.n
@@ -490,10 +490,16 @@
 the slot:
 .TP
 \fIslot\fR \fB\-append\fR ?\fImember ...\fR?
 .
 This appends the given \fImember\fR elements to the slot definition.
+.TP
+\fIslot\fR \fB\-appendifnew\fR ?\fImember ...\fR?
+.VS TIP567
+This appends the given \fImember\fR elements to the slot definition if they
+do not already exist in the slot.
+.VE TIP567
 .TP
 \fIslot\fR \fB\-clear\fR
 .
 This sets the slot definition to the empty list.
 .TP

Index: generic/tclOODefineCmds.c
==================================================================
--- generic/tclOODefineCmds.c
+++ generic/tclOODefineCmds.c
@@ -2436,13 +2436,18 @@
     Tcl_ObjectContext context,
     int objc,
     Tcl_Obj *const *objv)
 {
     Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int mixinc, i;
+    int mixinc, i, isNew;
     Tcl_Obj **mixinv;
-    Class **mixins;
+    Class **mixins;			/* The references to the classes to
+					 * actually install. */
+    Tcl_HashTable uniqueCheck;		/* Note that this hash table is just
+					 * used as a set of class references;
+					 * it has no payload values and keys
+					 * are always pointers. */
 
     if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
 	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
 		"mixinList");
 	return TCL_ERROR;
@@ -2460,17 +2465,25 @@
 	    &mixinv) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
+    Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS);
 
     for (i = 0; i < mixinc; i++) {
 	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
 		"may only mix in classes");
 	if (mixins[i] == NULL) {
 	    i--;
 	    goto freeAndError;
+	}
+	(void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew);
+	if (!isNew) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "class should only be a direct mixin once", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
+	    goto freeAndError;
 	}
 	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "may not mix a class into itself", -1));
 	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
@@ -2477,15 +2490,17 @@
 	    goto freeAndError;
 	}
     }
 
     TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
     TclStackFree(interp, mixins);
     return TCL_OK;
 
   freeAndError:
     TclStackFree(interp, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
     return TCL_ERROR;
 }
 
 /*
  * ----------------------------------------------------------------------
@@ -2838,11 +2853,11 @@
 }
 
 /*
  * ----------------------------------------------------------------------
  *
- * ObjectMixinGet, ObjectMixinSet --
+ * ObjMixinGet, ObjMixinSet --
  *
  *	Implementation of the "mixin" slot accessors of the "oo::objdefine"
  *	command.
  *
  * ----------------------------------------------------------------------
@@ -2887,14 +2902,18 @@
     Tcl_ObjectContext context,
     int objc,
     Tcl_Obj *const *objv)
 {
     Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int mixinc;
+    int mixinc, i, isNew;
     Tcl_Obj **mixinv;
-    Class **mixins;
-    int i;
+    Class **mixins;			/* The references to the classes to
+					 * actually install. */
+    Tcl_HashTable uniqueCheck;		/* Note that this hash table is just
+					 * used as a set of class references;
+					 * it has no payload values and keys
+					 * are always pointers. */
 
     if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
 	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
 		"mixinList");
 	return TCL_ERROR;
@@ -2906,23 +2925,36 @@
 	    &mixinv) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);
+    Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS);
 
     for (i = 0; i < mixinc; i++) {
 	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
 		"may only mix in classes");
 	if (mixins[i] == NULL) {
-	    TclStackFree(interp, mixins);
-	    return TCL_ERROR;
+	    goto freeAndError;
+	}
+	(void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew);
+	if (!isNew) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "class should only be a direct mixin once", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
+	    goto freeAndError;
 	}
     }
 
     TclOOObjectSetMixins(oPtr, mixinc, mixins);
     TclStackFree(interp, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
     return TCL_OK;
+
+  freeAndError:
+    TclStackFree(interp, mixins);
+    Tcl_DeleteHashTable(&uniqueCheck);
+    return TCL_ERROR;
 }
 
 /*
  * ----------------------------------------------------------------------
  *

Index: generic/tclOOScript.h
==================================================================
--- generic/tclOOScript.h
+++ generic/tclOOScript.h
@@ -96,13 +96,13 @@
 "\t\tforeach c [info class superclass $class] {\n"
 "\t\t\tset d [DelegateName $c]\n"
 "\t\t\tif {![info object isa class $d]} {\n"
 "\t\t\t\tcontinue\n"
 "\t\t\t}\n"
-"\t\t\tdefine $delegate ::oo::define::superclass -append $d\n"
+"\t\t\tdefine $delegate ::oo::define::superclass -appendifnew $d\n"
 "\t\t}\n"
-"\t\tobjdefine $class ::oo::objdefine::mixin -append $delegate\n"
+"\t\tobjdefine $class ::oo::objdefine::mixin -appendifnew $delegate\n"
 "\t}\n"
 "\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
 "\t\tset originDelegate [DelegateName $originObject]\n"
 "\t\tset targetDelegate [DelegateName $targetObject]\n"
 "\t\tif {\n"
@@ -148,48 +148,58 @@
 "\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
 "\t\t}\n"
 "\t\tmethod Resolve list {\n"
 "\t\t\treturn $list\n"
 "\t\t}\n"
-"\t\tmethod -set args {\n"
+"\t\tmethod -set -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\ttailcall my Set $args\n"
 "\t\t}\n"
-"\t\tmethod -append args {\n"
+"\t\tmethod -append -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
 "\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
 "\t\t}\n"
-"\t\tmethod -clear {} {tailcall my Set {}}\n"
-"\t\tmethod -prepend args {\n"
+"\t\tmethod -appendifnew -export args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset current [uplevel 1 [list $my Get]]\n"
+"\t\t\tforeach a $args {\n"
+"\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
+"\t\t\t\tif {$a ni $current} {\n"
+"\t\t\t\t\tlappend current $a\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\ttailcall my Set $current\n"
+"\t\t}\n"
+"\t\tmethod -clear -export {} {tailcall my Set {}}\n"
+"\t\tmethod -prepend -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
 "\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
 "\t\t}\n"
-"\t\tmethod -remove args {\n"
+"\t\tmethod -remove -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
 "\t\t\ttailcall my Set [lmap val $current {\n"
 "\t\t\t\tif {$val in $args} continue else {set val}\n"
 "\t\t\t}]\n"
 "\t\t}\n"
 "\t\tforward --default-operation my -append\n"
-"\t\tmethod unknown {args} {\n"
+"\t\tmethod unknown -unexport {args} {\n"
 "\t\t\tset def --default-operation\n"
 "\t\t\tif {[llength $args] == 0} {\n"
 "\t\t\t\ttailcall my $def\n"
 "\t\t\t} elseif {![string match -* [lindex $args 0]]} {\n"
 "\t\t\t\ttailcall my $def {*}$args\n"
 "\t\t\t}\n"
 "\t\t\tnext {*}$args\n"
 "\t\t}\n"
-"\t\texport -set -append -clear -prepend -remove\n"
-"\t\tunexport unknown destroy\n"
+"\t\tunexport destroy\n"
 "\t}\n"
 "\tobjdefine define::superclass forward --default-operation my -set\n"
 "\tobjdefine define::mixin forward --default-operation my -set\n"
 "\tobjdefine objdefine::mixin forward --default-operation my -set\n"
 "\tdefine object method <cloned> {originObject} {\n"

Index: tests/oo.test
==================================================================
--- tests/oo.test
+++ tests/oo.test
@@ -1682,28 +1682,20 @@
 
     rename obj1 {}
     # No segmentation fault
     return done
 } done
-
-test oo-11.6.1 {
-    OO: cleanup of when an class is mixed into itself
-} -constraints memory -body {
+test oo-11.6 {OO: cleanup of when an class is mixed into itself} memory {
     leaktest {
 	interp create interp1
 	oo::class create obj1
 	::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]}
 	rename obj1 {}
 	interp delete interp1
     }
-} -result 0 -cleanup {
-}
-
-test oo-11.6.2 {
-    OO: cleanup ReleaseClassContents() where class is mixed into one of its
-    instances
-} -constraints memory -body {
+} 0
+test oo-11.7 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} memory {
     leaktest {
 	interp create interp1
 	interp1 eval {
 	    oo::class create obj1
 	    ::oo::copy obj1 obj2
@@ -1710,17 +1702,12 @@
 	    rename obj2 {}
 	    rename obj1 {}
 	}
 	interp delete interp1
     }
-} -result 0 -cleanup {
-}
-
-test oo-11.6.3 {
-    OO: cleanup ReleaseClassContents() where class is mixed into one of its
-    instances
-} -constraints memory -body {
+} 0
+test oo-11.8 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} memory {
     leaktest {
 	interp create interp1
 	interp1 eval {
 	    oo::class create obj1
 	    ::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]}
@@ -1729,17 +1716,12 @@
 	    rename obj2 {}
 	    rename obj1 {}
 	}
 	interp delete interp1
     }
-} -result 0 -cleanup {
-}
-
-test oo-11.6.4 {
-    OO: cleanup ReleaseClassContents() where class is mixed into one of its
-    instances
-} -body {
+} 0
+test oo-11.9 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -body {
     oo::class create obj1
     ::oo::define obj1 {self mixin [self]}
 
     ::oo::copy obj1 obj2
     ::oo::objdefine obj2 {mixin [self]}
@@ -2216,10 +2198,35 @@
 	mixin mix
 	method test {} {lappend ::result cls; next; return $::result}
     }
     [cls new] test
 } -result {mix cls}
+test oo-14.9 {OO: class mixins must be unique in list} -setup {
+    oo::class create parent
+} -body {
+    oo::class create A {superclass parent}
+    oo::class create B {
+	superclass parent
+	mixin A
+    }
+    oo::define B mixin -append A
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {class should only be a direct mixin once}
+test oo-14.10 {OO: instance mixins must be unique in list} -setup {
+    oo::class create parent
+} -body {
+    oo::class create A {superclass parent}
+    oo::class create B {
+	superclass parent
+	constructor {} {oo::objdefine [self] mixin A}
+    }
+    B create obj
+    oo::objdefine obj {mixin -append A}
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {class should only be a direct mixin once}
 
 test oo-15.1 {OO: object cloning} {
     oo::class create Aclass
     oo::define Aclass method test {} {lappend ::result [self object]->test}
     Aclass create Ainstance
@@ -4195,11 +4202,24 @@
     # Method names beginning with "-" are special to slots
     $s -grill q
 } -returnCodes error -cleanup [SampleSlotCleanup {
     rename $s {}
 }] -result \
-    {unknown method "-grill": must be -append, -clear, -prepend, -remove, -set, contents or ops}
+    {unknown method "-grill": must be -append, -appendifnew, -clear, -prepend, -remove, -set, contents or ops}
+test oo-33.5 {TIP 567: slots -appendifnew} -setup [SampleSlotSetup {
+    set s [SampleSlot new]
+}] -body {
+    list \
+	[$s -clear
+	 $s contents] \
+	[$s -append p q r
+	 $s contents] \
+	[$s -appendifnew q s r t p
+	 $s contents]
+} -cleanup [SampleSlotCleanup {
+    rename $s {}
+}] -result {{} {p q r} {p q r s t}}
 
 test oo-34.1 {TIP 380: slots - presence} -setup {
     set obj [oo::object new]
     set result {}
 } -body {
@@ -4225,29 +4245,29 @@
     list [lsort [info object methods $obj -all]] \
 	[lsort [info object methods $obj -private]]
 }
 test oo-34.3 {TIP 380: slots - presence} {
     getMethods oo::define::filter
-} {{-append -clear -prepend -remove -set} {Get Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
 test oo-34.4 {TIP 380: slots - presence} {
     getMethods oo::define::mixin
-} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
 test oo-34.5 {TIP 380: slots - presence} {
     getMethods oo::define::superclass
-} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
 test oo-34.6 {TIP 380: slots - presence} {
     getMethods oo::define::variable
-} {{-append -clear -prepend -remove -set} {Get Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
 test oo-34.7 {TIP 380: slots - presence} {
     getMethods oo::objdefine::filter
-} {{-append -clear -prepend -remove -set} {Get Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
 test oo-34.8 {TIP 380: slots - presence} {
     getMethods oo::objdefine::mixin
-} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
 test oo-34.9 {TIP 380: slots - presence} {
     getMethods oo::objdefine::variable
-} {{-append -clear -prepend -remove -set} {Get Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
 test oo-34.10 {TIP 516: slots - resolution} -setup {
     oo::class create parent
     set result {}
     oo::class create 516a { superclass parent }
     oo::class create 516b { superclass parent }

Index: tests/ooUtil.test
==================================================================
--- tests/ooUtil.test
+++ tests/ooUtil.test
@@ -524,10 +524,33 @@
     cls create o pqr
     list [o foo] [pqr] [rename [info object namespace o]::my {}] [catch pqr msg] $msg
 } -cleanup {
     parent destroy
 } -result {{in foo of ::o} {in foo of ::o} {} 1 {invalid command name "pqr"}}
+
+# Tests a very weird combination of things (with a key problem locus in
+# MixinClassDelegates) that TIP 567 fixes
+test ooUtil-8.1 {TIP 567: call oo::define twice from metaclass constructor} -setup {
+    oo::class create parent
+} -body {
+    ::oo::class create A {
+	superclass parent
+    }
+    ::oo::class create B {
+	superclass ::oo::class parent
+    	constructor {{definitionScript ""}} {
+	    next $definitionScript
+	    next {superclass ::A}
+	}
+    }
+    B create C {
+	superclass A
+    }
+    C create instance
+} -cleanup {
+    parent destroy
+} -result ::instance
 
 # Tests that verify issues detected with the tcllib version of the code
 test ooUtil-tcllib-ticket-b3577ed586 {test scoping of delegation in oo::class.Delegate } -setup {
     oo::class create animal {}
     namespace eval ::ooutiltest {

Index: tools/tclOOScript.tcl
==================================================================
--- tools/tclOOScript.tcl
+++ tools/tclOOScript.tcl
@@ -151,13 +151,13 @@
 	foreach c [info class superclass $class] {
 	    set d [DelegateName $c]
 	    if {![info object isa class $d]} {
 		continue
 	    }
-	    define $delegate ::oo::define::superclass -append $d
+	    define $delegate ::oo::define::superclass -appendifnew $d
 	}
-	objdefine $class ::oo::objdefine::mixin -append $delegate
+	objdefine $class ::oo::objdefine::mixin -appendifnew $delegate
     }
 
     # ----------------------------------------------------------------------
     #
     # UpdateClassDelegatesAfterClone --
@@ -295,29 +295,40 @@
 	#	Standard public slot operations. If a slot can't figure out
 	#	what method to call directly, it uses --default-operation.
 	#
 	# ------------------------------------------------------------------
 
-	method -set args {
+	method -set -export args {
 	    set my [namespace which my]
 	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
 	    tailcall my Set $args
 	}
-	method -append args {
+	method -append -export args {
 	    set my [namespace which my]
 	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
 	    set current [uplevel 1 [list $my Get]]
 	    tailcall my Set [list {*}$current {*}$args]
 	}
-	method -clear {} {tailcall my Set {}}
-	method -prepend args {
+	method -appendifnew -export args {
+	    set my [namespace which my]
+	    set current [uplevel 1 [list $my Get]]
+	    foreach a $args {
+		set a [uplevel 1 [list $my Resolve $a]]
+		if {$a ni $current} {
+		    lappend current $a
+		}
+	    }
+	    tailcall my Set $current
+	}
+	method -clear -export {} {tailcall my Set {}}
+	method -prepend -export args {
 	    set my [namespace which my]
 	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
 	    set current [uplevel 1 [list $my Get]]
 	    tailcall my Set [list {*}$args {*}$current]
 	}
-	method -remove args {
+	method -remove -export args {
 	    set my [namespace which my]
 	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
 	    set current [uplevel 1 [list $my Get]]
 	    tailcall my Set [lmap val $current {
 		if {$val in $args} continue else {set val}
@@ -324,23 +335,22 @@
 	    }]
 	}
 
 	# Default handling
 	forward --default-operation my -append
-	method unknown {args} {
+	method unknown -unexport {args} {
 	    set def --default-operation
 	    if {[llength $args] == 0} {
 		tailcall my $def
 	    } elseif {![string match -* [lindex $args 0]]} {
 		tailcall my $def {*}$args
 	    }
 	    next {*}$args
 	}
 
-	# Set up what is exported and what isn't
-	export -set -append -clear -prepend -remove
-	unexport unknown destroy
+	# Conceal destroy; want slots to persist, please
+	unexport destroy
     }
 
     # Set the default operation differently for these slots
     objdefine define::superclass forward --default-operation my -set
     objdefine define::mixin forward --default-operation my -set