;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Application Connection
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/application-connection.lisp
;;; File Creation Date: 07/23/92 15:35:01
;;; Last Modification Time: 07/24/92 12:45:10
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)

;;; Mixin class application-mixin provides a connection between
;;; interaction objects and application objects by establishing a link
;;; from the interaction object to the application object and by defining
;;; an interface to ensure consistency between user interface and
;;; application via read and write functions and transformations
;;; 
;;; Interface for interaction objects using application-mixin:
;;; 
;;; Slots (or initargs):
;;; 
;;; view-of               link to the application object
;;;                       (mixed in by class view)
;;; read-function         holds a function for reading a value from the application
;;; 
;;; write-function        holds a function for writing a value to the application
;;; 
;;; read-transformation   holds a function for transforming the read value
;;;                       (mixed in by class transformation-mixin)
;;; write-transformation  holds a function for transforming the written value
;;; (mixed in by class transformation-mixin)
;;; 
;;; Methods:
;;; 
;;; identification, (setf identification)        
;;;              returns or sets the internal value, that is represented by the 
;;;              interaction object. By default, this is the view-of.  Specific
;;;              intercation objects typically redefine this method, e.g.,
;;;              for menus, the values of the selected item(s) are used.
;;; 
;;; value, (setf value)
;;;              returns or sets the application value, that is represented by the 
;;;              interaction object, ie. the transformed identification
;;; 
;;; application-value, (setf application-value)
;;;              returns or sets the corresponding value of the application
;;; 
;;; read-value   updates the interaction object according to the application,
;;;              ie. the value is set to the application-value.
;;; 
;;; write-value  updates the application according to the interaction object 
;;;              ie. the application-value is set to the value.


(defclass application-mixin (transformation-mixin view)
  ((read-function :initform nil
		  :accessor read-function :initarg :read-function)
   (write-function :initform nil
		   :accessor write-function :initarg :write-function)))

(defmethod identification ((self application-mixin))
  (view-of self)) ;; to be specialized by subclasses

(defmethod (setf identification) (value (self application-mixin))
  (setf (view-of self) value)) ;; to be specialized by subclasses

(defmethod value ((self application-mixin))
  "Apply write-transformation to the interface value."
  (write-transform self (identification self)))

(defmethod (setf value) (value (self application-mixin))
  "Apply read-transformation to the interface value before setf-ing."
  (setf (identification self)
      (read-transform self value)))

(defmethod application-value ((self application-mixin))
  (with-accessors ((read-function read-function) (view-of view-of)) self
     (when read-function
       (if view-of
	   (funcall read-function view-of) 
	 (funcall read-function)))))

(defmethod (setf application-value) (new-value (self application-mixin))
  (with-accessors ((write-function write-function)
		   (read-function read-function)
		   (view-of view-of)) self
    (if write-function
	(if view-of
	    (funcall write-function view-of new-value)
	  (funcall write-function new-value))
      (when view-of
	(eval `(setf (,read-function ',view-of) ',new-value))))))

(defmethod read-value ((self application-mixin))
  (with-slots (read-function) self
    (when read-function
      (setf (value self) (application-value self)))))

(defmethod write-value ((self application-mixin))
  (with-slots (read-function write-function) self
    (when (or write-function read-function)
      (setf (application-value self) (value self)))))
