+(defaction fill (what) "You can't fill that.")\r
+\r
+(defaction empty (what) "That doesn't make sense.")\r
+\r
+(defmethod empty ((obj container))\r
+ (unless (has obj :container) (return-from empty (call-next-method)))\r
+ (if (has obj :closed)\r
+ "But it is closed!"\r
+ (if (children obj)\r
+ (objectloop (in x obj)\r
+ (sprint "~a: " (print-name x))\r
+ (run-action 'extract (list x obj)))\r
+ "It is already empty.")))\r
+\r
+(defaction extract (obj1 obj2 &key silent) "You can't do that.")\r
+\r
+(defmethod extract ((item item) (host container) &key silent)\r
+ (unless (has item :item) (return-from extract (call-next-method)))\r
+ (unless (has host :container) (return-from extract (call-next-method)))\r
+ (when (has host :closed) \r
+ (return-from extract \r
+ (format nil "~a is closed." (the-name host :capital t))))\r
+ (and (run-action 'let-go (reverse *args*))\r
+ *after*\r
+ (run-action-after item) \r
+ (if silent t "Done."))) \r
+\r
+(defmethod extract ((item item) (host supporter) &key silent)\r
+ (unless (has item :item) (return-from extract (call-next-method)))\r
+ (unless (has host :supporter) (return-from extract (call-next-method)))\r
+ (and (run-action 'let-go (reverse *args*))\r
+ *after*\r
+ (run-action-after item)\r
+ (if silent t "Done.")))\r
+\r
+(defaction extract-silent (obj1 obj2)\r
+ (extract obj1 obj2 :silent t))\r
+\r
+(defaction let-go (host thing)\r
+ "Something's wrong happened.")\r
+\r
+(defmethod let-go ((host supporter) (item item))\r
+ (move item (parent host))\r
+ (run-action-after host))\r
+\r
+(defmethod let-go ((host container) (item item))\r
+ (move item (parent host))\r
+ (run-action-after host))\r