;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: XIT; Base: 10; -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: 
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Hubertus Hohl
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/shadow-borders.lisp
;;; File Creation Date: 11/29/90 11:37:22
;;; Last Modification Time: 07/31/92 15:59:42
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________


(in-package :xit)

(defcontact shadow-border (basic-window contact)
  ((name :initform :shadow)
   ;(border-width :initform 0)
   (shadow-of :initarg :shadow-of))
  (:resources
   (background :initform "black")))

(defmethod realize :after ((self shadow-border))
  (with-slots (shadow-of) self
    (when (and shadow-of (realized-p shadow-of))
      (change-priority self :below :sibling shadow-of))))

;;;
;;; *** NOTE: SHADOW-BORDERS-MIXIN should be specified first 
;;;           in the list of superclasses!
;;;
(defclass shadow-borders-mixin ()
  ((shadow :initform nil)
   (shadow-offset :allocation :class
		  :initform 4)
   (shadow-background :allocation :class
		      :initform nil))
  (:documentation "Provides shadow borders on the right and bottom side."))

(defmethod initialize-instance :around ((self shadow-borders-mixin) &rest initargs)
  (with-slots (shadow shadow-background shadow-offset x y parent state) self
    (call-next-method)
    (setf shadow
	  (apply #'make-window 'shadow-border
		 :parent parent
		 :shadow-of self
		 :state state
		 :layouted? nil
		 :x (+ x shadow-offset)
		 :y (+ y shadow-offset)
		 :width (max 1 (contact-total-width self))
		 :height (max 1 (contact-total-height self))
		 (and shadow-background
		      (list :background shadow-background))))))

(defmethod realize :after ((self shadow-borders-mixin))
  (with-slots (shadow) self
    (when (and shadow (realized-p shadow))
      (change-priority shadow :below :sibling self))))

;;; Trigger for reparenting window
;;;
(defmethod (setf contact-parent) :around (new-parent (self shadow-borders-mixin) &key x y)
  (with-slots (shadow x y shadow-offset) self
    (if shadow
	(let ((actual-state (contact-state shadow)))
	  (setf (contact-state shadow) :managed)
	  (prog1 (call-next-method)
		 (setf (contact-parent shadow
				       :x (+ x shadow-offset)
				       :y (+ y shadow-offset))
		       new-parent)
		 (change-priority shadow :below :sibling self)
		 (setf (contact-state shadow) actual-state)))
        (call-next-method))))

;;; Trigger for changing stacking order
;;;
(defmethod (setf cluei::contact-priority) :around (new-priority (self shadow-borders-mixin)
                                           &optional new-sibling)
  (with-slots (shadow) self
    (if shadow
	(let ((actual-state (contact-state shadow)))
	  (setf (contact-state shadow) :managed)
	  (prog1 (call-next-method)
		 (change-priority shadow :below :sibling self)
		 (setf (contact-state shadow) actual-state)))
        (call-next-method))))

;;; Triggers for state changes
;;;
(defmethod (setf contact-state) :around (new-state (self shadow-borders-mixin))
  (with-slots (shadow) self
    (when (and shadow
	       (not (eq new-state :mapped)))
      (setf (contact-state shadow) new-state))
    (prog1 (call-next-method)
	   (when (and shadow
		      (eq new-state :mapped))
	     (change-priority shadow :below :sibling self)
	     (setf (contact-state shadow) new-state)))))

(defmethod destroy :after ((self shadow-borders-mixin))
  (with-slots (shadow) self
    (when shadow
      (destroy shadow))))

;;; Triggers for geometry changes
;;;
(defmethod move-window-with-mouse :around ((self shadow-borders-mixin)
                                            &key type drag in-bounds)
  (with-slots (shadow) self
    (if shadow
	(let ((actual-state (contact-state shadow)))
	  (setf (contact-state shadow) :managed)
	  (prog1 (call-next-method)
	         (setf (contact-state shadow) actual-state)))
        (call-next-method))))

(defmethod move ((self shadow-borders-mixin) x y)
  (with-slots (shadow shadow-offset) self
    (if shadow
	(let ((actual-state (contact-state shadow)))
	  (setf (contact-state shadow) :managed)
	  (prog1 (call-next-method)
		 (move-window shadow (+ x shadow-offset) (+ y shadow-offset))
		 (setf (contact-state shadow) actual-state)))
        (call-next-method))))

(defmethod resize ((self shadow-borders-mixin) w h bw)
  (with-slots (shadow) self
    (if shadow
	(let ((actual-state (contact-state shadow)))
	  (setf (contact-state shadow) :managed)
	  (prog1 (call-next-method)
		 (resize-window shadow
				(contact-total-width self)
				(contact-total-height self))
		 (setf (contact-state shadow) actual-state)))
        (call-next-method))))






  

  
    
	
  





