;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: 
;;;                       Module: 
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Matthias Ressel
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/focus.lisp
;;; File Creation Date: 02/11/92 14:26:21
;;; Last Modification Time: 10/06/92 17:05:48
;;; Last Modification By: Matthias Ressel
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;; 02/10/1992 (Matthias) New stuff supporting keyboard-focus: 
;;; An interaction-window containing the focus-mixin will dispatch
;;; key-press event to a specific window in its subwindow hierarchie,
;;; its focus. This subwindow will send a request for getting the focus
;;; to its ancestors in the window hierarchie, the first window with
;;; an focus not equal to nil will accept it.
;;; Changing the focus results in a call take-focus. This method should be redefined
;;; in the appropriate classes.
;;; A window may also release its focus (e.g. accept-text) by sending a release 
;;; focus "event"
;;;
;;;_____________________________________________________________________________

(in-package :xit)

(defclass focus-mixin ()
  ;; keyboard-focus = :pass -> do not accept any focus, pass key-press events
  ;; keyboard-focus = nil   -> no focus set, handles key-press events by itself
  ;; keyboard-focus = window -> focus set, dispatch key-press events to focus window
  ((keyboard-focus :initform nil :accessor keyboard-focus)))

(defvar *keyboard-focus-event* :keyboard-focus)

(defmethod focus-set-p ((self focus-mixin))
  "Returns non nil if focus is set."
  (with-slots (keyboard-focus) self
    (and keyboard-focus (not (eq keyboard-focus :pass)))))

(defmethod pass-focus-p ((self focus-mixin))
  (eq (keyboard-focus self) :pass))

(defmethod handle-focus-event ((self focus-mixin) (key (eql :request)) window)
  (let ((old-focus (keyboard-focus self)))
    (unless (eq window old-focus)
      (when old-focus (take-focus old-focus))
      (setf (keyboard-focus self) window)
      (change-reactivity self *keyboard-focus-event*)
      self)))

(defmethod handle-focus-event ((self focus-mixin) (key (eql :release)) window)
  (let ((old-focus (keyboard-focus self)))
    (when (eq old-focus window)
      (setf (keyboard-focus self) nil)
      self)))

(defmethod take-focus ((self t))
  "This function is called upon a window if another requests input focus.
   Should be specialized by subclasses."
  nil)

(defmethod keyboard-action ((self focus-mixin))
  (with-event (character)
    (with-slots (keyboard-focus) self
    (if (focus-set-p self)
      (funcall #'key-press keyboard-focus character)
      (key-press self character)))))

(defmethod send-focus-event ((self focus-mixin) key focus-window)
  (with-slots (parent) self
    (if (not (pass-focus-p self))
	(handle-focus-event self key focus-window)
      (send-focus-event parent key focus-window))))

(defmethod send-focus-event ((self basic-contact) key focus-window)
  (with-slots (parent) self
    (when parent (send-focus-event parent key focus-window))))

