;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;__________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Views
;;;                       (Version 1.0)
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/view.lisp
;;; File Creation Date: 6/23/89 10:31:37
;;; Last Modification Time: 12/04/92 10:56:00
;;; Last Modification By: Hubertus Hohl
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;; 07/16/1992 (Juergen)  For class view-mixin the view-of slot of an object
;;;                       referenced by means of the view slot is now updated,
;;;                       ie. it always points to the corresponding application
;;;                       object.  To this end, the methods view-of and
;;;                       (setf view-of) for non-interaction-windows have been
;;;                       defined; they just do nothing.
;;;
;;; 07/30/1992 (Juergen)  New function get-view-of and (setf get-view-of) to
;;;                       access the view-of SLOT of a view.
;;;                       Note that the function view-of retrieves the first
;;;                       non-nil value in the interaction-object hierarchy
;;;                       instead of the slot value.  view-of and 
;;;                       (setf view-of) still are the preferred interface!
;;;__________________________________________________________________________

(in-package :xit)

;____________________________________________________________________________
;
;                              View
;____________________________________________________________________________

(defclass view ()
  ((view-of :initform nil :initarg :view-of
	    :accessor get-view-of))
  (:documentation "Views provide access from user interface objects (windows) 
                   to application objects"))

(defmethod view-of ((self view))
  (with-slots (parent view-of) self
    (or view-of
	(and parent (view-of parent)))))

(defmethod view-of ((self t))
  nil)

(defmethod (setf view-of) (view-of (object t))
  (declare (ignore view-of))
  nil)

(defmethod (setf view-of) (value (self view))
  (with-slots (view-of) self
    (setf view-of value)))

;____________________________________________________________________________
;
;                            View-Mixin
;____________________________________________________________________________

(defclass view-mixin ()
  ((view :type view :initform nil :accessor view :initarg :view))
  (:documentation "Class view-mixin provides access from application objects 
                   to user interface objects (windows)"))

(defmethod initialize-instance :after ((self view-mixin) &rest init-list)
  (declare (ignore init-list))
  ;; establish backpointer for view
  (with-slots (view) self
    (setf (view-of view) self)))

(defmethod (setf view) :before (new-view (self view-mixin))
  (with-slots (view) self
    (when (and (not (eq new-view view))
	       (eq (view-of view) self))
      (setf (view-of view) nil))))

(defmethod (setf view) :after (new-view (self view-mixin))
  (unless (eq (view-of new-view) self)
    (setf (view-of new-view) self)))


